(GLOBAL (FUNCTIONS TRY-NEXT NOTE ADIEU AU-REVOIR INSTANCE GET-POSSIBILITIES SET-POSSIBILITIES)
	(RESERVED *IGNORE *ITEM *NOTE *METHOD *GENERATOR *AU-REVOIR *BLOCK))

(DECLARE (SPECIAL TEM TEM1 TEM2 ALINK BVARS EXP CLINK FRAME* VAL)
	 (*FEXPR CERR INSTANCE PROPOSE /,)
	 (*LEXPR CSET VFRAME ACCESS CONTROL))

(DEFPROP ALINK (LAMBDA (L) (LIST (QUOTE CDADR) (CADR L))) MACRO)

(DEFPROP CLINK (LAMBDA (L) (LIST (QUOTE CDDDR) (CADR L))) MACRO)

(CDEFUN TRY-NEXT
	(POSSIBILITIES ⊗OPTIONAL⊗ (NOMORE NIL) (MESSAGE NIL))
        ⊗AUX⊗
	(POS)
	(: TRY-NEXT)
	(GO (NEXT))
	(: EXIT)
	(RETURN (CEVAL NOMORE (ACCESS)))
	(: RETURN)
	(RETURN POS)
	(: *METHOD)
	(METGO)
	(: *GENERATOR)
	(GENGO)
	(: *AU-REVOIR)
	(REGO)
	(: *BLOCK)
	(TBLOCK))

(DEFPROP NEXT
	 (LAMBDA(L)
	  (PROG NIL
		(SETQ L (/, POSSIBILITIES))
		(COND ((OR (ATOM L) (NOT (EQ (CAAR L) (QUOTE *POSSIBILITIES)))) (CERR BAD POSSIBILITIES LIST)))
		(RETURN
		 (PROG (P)
		       (COND ((NULL (CDR L)) (RETURN (QUOTE EXIT))))
		       (UNBLOCK (CDR L))
 		  TN   (RPLACD L (CDDR L))
		       (COND ((NULL (CDR L)) (RETURN (QUOTE EXIT)))
			     ((EQ (SETQ P (CADR L)) (QUOTE *IGNORE)) (GO TN))
			     ((ATOM P) (CSET (QUOTE POS) P) (RETURN (QUOTE RETURN)))
			     ((EQ (CAR P) (QUOTE *ITEM)) (SETUP (CADDR P))
							 (CSET (QUOTE POS) (CADR P))
							 (RETURN (QUOTE RETURN)))
			     ((EQ (CAR P) (QUOTE *NOTE)) (SETUP (CADR P))
							 (CSET (QUOTE POS) P)
							 (RETURN (QUOTE RETURN)))
			     ((MEMQ (CAR P) (QUOTE (*METHOD *GENERATOR *AU-REVOIR *BLOCK))) (RETURN (CAR P)))
			     (T (CSET (QUOTE POS) P) (RETURN (QUOTE RETURN))))))))
 	 FEXPR)

(DEFPROP SETUP
	 (LAMBDA(ALIST)
	  (PROG NIL
		(SETQ TEM (ACCESS))
		(RETURN (MAPC (QUOTE (LAMBDA (PAIR) (CSET (CAR PAIR) (CADR PAIR) TEM))) ALIST))))
 	 EXPR)

(DEFPROP GENGO
	 (LAMBDA NIL
	  (PROG NIL
		(SETQ TEM
		      (CDR (IVAL (QUOTE POSSIBILITIES) ALINK))
 		      BVARS
		      (LIST (LIST (QUOTE NEXT) TEM))
 		      CLINK
		      (FR (TAG (QUOTE TRY-NEXT)))
 		      ALINK
		      (ALINK CLINK)
 		      TEM1
		      (CADAR TEM)
 		      FRAME*
 		      NIL)
		(RPLACA TEM (LIST (QUOTE *BLOCK)))
		(RETURN (DISPATCH TEM1 (QUOTE POPJ) NIL (QUOTE *TOP)))))
 	 EXPR)

(DEFPROP GENGO GENGO CINT)

(DEFPROP METGO
	 (LAMBDA NIL
	  (PROG NIL
		(SETQ TEM
		      (IVAL (QUOTE POSSIBILITIES) ALINK)
 		      TEM2
		      (CADAR TEM)
 		      TEM
		      (CDR TEM)
 		      TEM1
		      (CADAR TEM)
 		      BVARS
		      (NCONC (LIST (LIST (QUOTE NEXT) TEM)
				   (LIST (QUOTE *BODY) (TEXT TEM1))
				   (LIST (QUOTE *CALLPAT) TEM2)
				   (LIST (QUOTE *METHPAT) (PATTERN TEM1))
				   (LIST (QUOTE *CALLALIST) (CADDDR (CAR TEM)))
				   (LIST (QUOTE *METHALIST) (CADDAR TEM)))
			     (CADDAR TEM))
 		      EXP
		      (LIST TEM1 TEM2)
 		      FRAME*
 		      NIL
 		      CLINK
		      (FR (TAG (QUOTE TRY-NEXT)))
 		      ALINK
		      (ALINK CLINK))
		(CLOSE)
		(RPLACA TEM (LIST (QUOTE *BLOCK)))
		(RETURN (QUOTE AUXB))))
 	 EXPR)

(DEFPROP METGO METGO CINT)

(DEFPROP REGO
	 (LAMBDA NIL
	  (PROG NIL
		(SETQ TEM
		      (CDR (IVAL (QUOTE POSSIBILITIES) ALINK))
 		      VAL
		      (IVAL (QUOTE MESSAGE) ALINK)
 		      FRAME*
		      (CADAR TEM))
		(SETCONTROL (VFRAME (QUOTE NEXT) (CAR TEM)) (TAG (QUOTE TRY-NEXT)))
		(RPLACA TEM (LIST (QUOTE *BLOCK)))
		(RETURN (RESTORE))))
 	 EXPR)

(DEFPROP REGO REGO CINT)

(CDEFUN TBLOCK
        NIL
	(NCONC (CADR POSSIBILITIES) (TAG (QUOTE TRY-NEXT)))
	(ALLOW NIL)
	(COND ((/@ . READY) (CONTINUE (/@ PROG2 (ALLOW T) (CAR READY) (SETQ READY (CDR READY))))))
	(ALLOW T)
	(LISTEN (QUOTE ALL-BLOCKED-UP)))

(DEFPROP UNBLOCK
	 (LAMBDA(L)
	  (COND
	   ((EQ (CAAR L) (QUOTE *BLOCK)) (NCONC (GET (QUOTE READY) (QUOTE VALUE)) (CDAR L))
					 (RPLACA L (QUOTE *IGNORE)))))
 	 EXPR)

(DEFPROP NOTE
	 (LAMBDA N
	  (COND ((= N 0) ((LAMBDA (P) (COND (P (ENTER P)))) (INSTANCE)) 0)
		(T
		 (PROG (NEXT M)
		       (SETQ M 0 NEXT (CDR (VLOC (QUOTE NEXT))))
 		  LP   (COND ((> (SETQ M (/1+ M)) N) (RETURN N)))
		       (RPLACD (CAR NEXT) (CONS (ARG M) (CDAR NEXT)))
		       (RPLACA NEXT (CDAR NEXT))
		       (GO LP)))))
 	 EXPR)

(CDEFUN ADIEU (⊗REST⊗ L) (PROPOSE) (DISMISS (VFRAME (QUOTE NEXT))))

(CDEFUN AU-REVOIR
	(⊗REST⊗ L)
	(PROPOSE)
	(ENTER (CONS (QUOTE *AU-REVOIR) (CDR (CONTROL))))
	(DISMISS (VFRAME (QUOTE NEXT))))

(DEFPROP ENTER
	 (LAMBDA(X)
	  (PROG NIL
		(SETQ TEM (CDR (VLOC (QUOTE NEXT))))
		(RPLACD (CAR TEM) (CONS X (CDAR TEM)))
		(RETURN (RPLACA TEM (CDAR TEM)))))
 	 EXPR)

(DEFPROP PROPOSE
	 (LAMBDA(L)
	  (PROG NIL
		(SETQ L (CDR (VLOC (QUOTE NEXT))))
		(RETURN
		 (MAPC (QUOTE
			(LAMBDA(X)
			 (PROG NIL (RPLACD (CAR L) (CONS X (CDAR L))) (RETURN (RPLACA L (CDAR L))))))
		       (/, L)))))
 	 FEXPR)

(DEFPROP INSTANCE
	 (LAMBDA(L)
	  (PROG (NEXTF CALLA)
		(SETQ NEXTF
		      (FR (VFRAME (QUOTE NEXT)))
 		      CALLA
		      (IVAL (QUOTE *CALLALIST) NEXTF)
 		      L
		      (MATCH (IVAL (QUOTE *CALLPAT) NEXTF)
			     (IVAL (QUOTE *METHPAT) NEXTF)
 			     CALLA
			     (IVAL (QUOTE *METHALIST) NEXTF)))
		(COND (L (RETURN (LIST (QUOTE *NOTE) (CPY (CAR L))))))))
 	 FEXPR)

(DEFPROP CPY (LAMBDA (L) (MAPCAR (QUOTE (LAMBDA (X) (LIST (CAR X) (CADR X)))) L)) EXPR)

(DEFPROP GET-POSSIBILITIES (LAMBDA NIL (IVAL (QUOTE POSSIBILITIES) (CLINK (FR (VFRAME (QUOTE NEXT)))))) FEXPR)

(DEFPROP SET-POSSIBILITIES
	 (LAMBDA (LIST) (CSET (QUOTE POSSIBILITIES) LIST (CONTROL (VFRAME (QUOTE NEXT)))))
 	 EXPR)